home *** CD-ROM | disk | FTP | other *** search
/ LiquidLibrary 2005 September / LiquidLibrary 2005 Sep - Disc 1.iso / pc / Portfolio Browser / Filters / PDF / LIB / gs_setpd.ps < prev    next >
Text File  |  2003-01-03  |  25KB  |  758 lines
  1. %    Copyright (C) 1994, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This software is licensed to a single customer by Artifex Software Inc.
  4. % under the terms of a specific OEM agreement.
  5.  
  6. % $RCSfile$ $Revision$
  7. % The current implementation of setpagedevice has the following limitations:
  8. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  9.  
  10. languagelevel 1 .setlanguagelevel
  11. level2dict begin
  12.  
  13. % ---------------- Redefinitions ---------------- %
  14.  
  15. % Redefine .beginpage and .endpage so that they call BeginPage and
  16. % EndPage respectively if appropriate.
  17.  
  18. % We have to guard against the BeginPage procedure not popping its operand.
  19. % This is really stupid, but the Genoa CET does it.
  20. /.beginpage {        % - .beginpage -
  21.   .currentshowpagecount {
  22.     .currentpagedevice pop
  23.     dup null ne { /BeginPage .knownget } { pop false } ifelse {
  24.         % Stack: ... pagecount proc
  25.        count 2 .execn
  26.         % Stack: ... ..???.. oldcount
  27.        count 1 add exch sub { pop } repeat
  28.     } {
  29.       pop
  30.     } ifelse
  31.   } if
  32. } bind odef
  33.  
  34. % Guard similarly against EndPage not popping its operand.
  35. /.endpage {        % <reason> .endpage <print_bool>
  36.   .currentshowpagecount {
  37.     1 index .currentpagedevice pop
  38.     dup null ne { /EndPage .knownget } { pop false } ifelse {
  39.         % Stack: ... reason pagecount reason proc
  40.       count 2 .execn
  41.         % Stack: ... ..???.. print oldcount
  42.       count 2 add exch sub { exch pop } repeat
  43.     } {
  44.       pop pop 2 ne
  45.     } ifelse
  46.   } {
  47.     2 ne
  48.   } ifelse
  49. } bind odef
  50.  
  51. % Define interpreter callouts for handling gstate-saving operators,
  52. % to make sure that they create a page device dictionary for use by
  53. % the corresponding gstate-restoring operator.
  54. % We'd really like to avoid the cost of doing this, but we don't see how.
  55. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  56. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  57. % interpreter.
  58.  
  59. (%gsavepagedevice) cvn
  60.  { currentpagedevice pop gsave
  61.  } bind def
  62.  
  63. (%savepagedevice) cvn
  64.  { currentpagedevice pop save
  65.  } bind def
  66.  
  67. (%gstatepagedevice) cvn
  68.  { currentpagedevice pop gstate
  69.  } bind def
  70.  
  71. (%copygstatepagedevice) cvn
  72.  { currentpagedevice pop copy
  73.  } bind def
  74.  
  75. (%currentgstatepagedevice) cvn
  76.  { currentpagedevice pop currentgstate
  77.  } bind def
  78.  
  79. % Define interpreter callouts for handling gstate-restoring operators
  80. % when the current page device needs to be changed.
  81. % The names %grestorepagedevice, %grestoreallpagedevice,
  82. % %restorepagedevice, %restore1pagedevice, and %setgstatepagedevice
  83. % are known to the interpreter.
  84.  
  85. /.installpagedevice
  86.  {    % Since setpagedevice doesn't create new device objects,
  87.     % we must (carefully) reinstall the old parameters in
  88.     % the same device.
  89.    .currentpagedevice pop null currentdevice null .trysetparams
  90.    dup type /booleantype eq
  91.     { pop pop }
  92.     {        % This should never happen!
  93.       DEBUG { (Error in .trysetparams!) = pstack flush } if
  94.       cleartomark pop pop pop
  95.       /.installpagedevice cvx /rangecheck signalerror
  96.     }
  97.    ifelse pop pop
  98.     % A careful reading of the Red Book reveals that an erasepage
  99.     % should occur, but *not* an initgraphics.
  100.    erasepage .beginpage
  101.  } bind def
  102.  
  103. /.uninstallpagedevice
  104.  { 2 .endpage { .currentnumcopies false .outputpage } if
  105.    nulldevice
  106.  } bind def
  107.  
  108. (%grestorepagedevice) cvn
  109.  { .uninstallpagedevice grestore .installpagedevice
  110.  } bind def
  111.  
  112. (%grestoreallpagedevice) cvn
  113.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  114.  } bind def
  115.  
  116. (%restore1pagedevice) cvn
  117.  { .uninstallpagedevice grestore .installpagedevice restore
  118.  } bind def
  119.  
  120. (%restorepagedevice) cvn
  121.  { .uninstallpagedevice restore .installpagedevice
  122.  } bind def
  123.  
  124. (%setgstatepagedevice) cvn
  125.  { .uninstallpagedevice setgstate .installpagedevice
  126.  } bind def
  127.  
  128. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  129. /.numcopiesdict mark
  130.   /NumCopies dup
  131. .dicttomark readonly def
  132.  
  133. /.currentnumcopies
  134.  { currentdevice //.numcopiesdict .getdeviceparams
  135.    dup type /integertype eq
  136.     { exch pop exch pop }
  137.     { cleartomark #copies }
  138.    ifelse
  139.  } bind odef
  140.  
  141. % Redefine .currentpagedevice and .setpagedevice so they convert between
  142. % null and a fixed empty directionary.
  143. /.nullpagedevice 0 dict readonly def
  144. /.currentpagedevice {
  145.   //.currentpagedevice exch dup null eq { pop //.nullpagedevice } if exch
  146. } bind odef
  147. /.setpagedevice {
  148.   dup //.nullpagedevice eq { pop null } if //.setpagedevice
  149. } bind odef
  150.  
  151. % ---------------- Auxiliary definitions ---------------- %
  152.  
  153. % Define the required attributes of all page devices, and their default values.
  154. % We don't include attributes such as .MediaSize, which all devices
  155. % are guaranteed to supply on their own.
  156. /.defaultpolicies mark
  157.   /PolicyNotFound 1
  158.   /PageSize 0
  159.   /PolicyReport {pop} bind
  160. .dicttomark readonly def
  161. % Note that the values of .requiredattrs are executed, not just fetched.
  162. /.requiredattrs mark
  163.   /PageDeviceName null
  164.   /PageOffset [0 0] readonly
  165. % We define InputAttributes and OutputAttributes with a single
  166. % dummy media type that handles pages of any size.
  167. % Devices that care will override this.
  168.   /InputAttributes {
  169.     mark 0
  170.     % Since sizes match within 5 user units, we need to set the smallest
  171.     % PageSize to 6 units so that [0 0] will fail.
  172.     mark /PageSize [6 dup 16#7ffff dup] .dicttomark
  173.     .dicttomark
  174.   }
  175.   (%MediaSource) 0
  176.   /OutputAttributes {
  177.     mark 0 mark .dicttomark readonly .dicttomark
  178.   }
  179.   (%MediaDestination) 0
  180.   /Install {{.callinstall}} bind
  181.   /BeginPage {{.callbeginpage}} bind
  182.   /EndPage {{.callendpage}} bind
  183.   /Policies .defaultpolicies
  184. .dicttomark readonly def
  185.  
  186. % Define currentpagedevice so it creates the dictionary on demand if needed,
  187. % adding all the required entries defined just above.
  188. % We have to deal specially with entries that the driver may change
  189. % on its own.
  190. /.dynamicppkeys mark
  191.   /.MediaSize dup        % because it changes when PageSize is set
  192.   /PageCount dup
  193. .dicttomark readonly def
  194. /.makecurrentpagedevice {    % - .makecurrentpagedevice <dict>
  195.   currentdevice null .getdeviceparams
  196.     % Make the dictionary large enough to add defaulted entries.
  197.   counttomark 2 idiv .requiredattrs length add dict
  198.   counttomark 2 idiv { dup 4 2 roll put } repeat exch pop
  199.     % Add any missing required attributes.
  200.     % Make a writable and (if possible) local copy of any default
  201.     % dictionaries, to work around a bug in the output of WordPerfect,
  202.     % which assumes that these dictionaries are writable and local.
  203.   .currentglobal exch dup gcheck .setglobal
  204.   .requiredattrs {
  205.     2 index 2 index known {
  206.       pop pop
  207.     } {
  208.       exec 2 index 3 1 roll put
  209.     } ifelse
  210.   } forall exch .setglobal
  211.   dup .setpagedevice
  212. } bind def
  213. /currentpagedevice {
  214.   .currentpagedevice {
  215.     dup length 0 eq {
  216.       pop .makecurrentpagedevice
  217.     } {
  218.         % If any of the dynamic keys have changed,
  219.         % we must update the page device dictionary.
  220.       currentdevice //.dynamicppkeys .getdeviceparams .dicttomark {
  221.         % Stack: current key value
  222.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  223.          { 2 index wcheck not
  224.         {    % This is the first entry being updated.
  225.             % Copy the dictionary to make it writable.
  226.           3 -1 roll dup length dict .copydict
  227.           3 1 roll
  228.         }
  229.            if
  230.            2 index 3 1 roll put
  231.          }
  232.          { pop pop
  233.          }
  234.         ifelse
  235.       } forall
  236.         % If the dictionary was global and is now local, copy
  237.         % any global subsidiary dictionaries to local VM.  This
  238.         % too is to work around the Word Perfect bug (see above).
  239.       dup gcheck not {
  240.     dup {
  241.       dup type /dicttype eq { dup gcheck } { false } ifelse {
  242.         % Copy-on-write, see above.
  243.         2 index wcheck not {
  244.           3 -1 roll dup length dict .copydict
  245.           3 1 roll
  246.         } if
  247.         .copytree 2 index 3 1 roll put
  248.       } {
  249.         pop pop
  250.       } ifelse
  251.     } forall
  252.       } if
  253.         % We would like to do a .setpagedevice so we don't keep
  254.         % re-creating the dictionary.  Unfortunately, the effect
  255.         % of this is that if any dynamic key changes (PageCount
  256.         % in particular), we will do the equivalent of a
  257.         % setpagedevice at the next restore or grestore.
  258.         % Therefore, we make the dictionary read-only, but
  259.         % we don't store it away.  I.e., NOT:
  260.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  261.       readonly
  262.     } ifelse
  263.   } if
  264. } bind odef
  265.  
  266. % Copy a dictionary recursively.
  267. /.copytree {    % <dict> .copytree <dict'>
  268.   dup length dict exch {
  269.     dup type /dicttype eq { .copytree } if 2 index 3 1 roll put
  270.   } forall
  271. } bind def
  272.  
  273. % The implementation of setpagedevice is quite complex.  Currently,
  274. % everything but the media matching algorithm is implemented here.
  275.  
  276. % By default, we only present the requested changes to the device,
  277. % but there are some parameters that require special merging action.
  278. % Define those parameters here, with the procedures that do the merging.
  279. % The procedures are called as follows:
  280. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  281. /.mergespecial mark
  282.   /InputAttributes
  283.    { dup null eq
  284.       { pop null
  285.       }
  286.       { 3 copy pop .knownget
  287.      { dup null eq
  288.         { pop dup length dict }
  289.         { dup length 2 index length add dict .copydict }
  290.        ifelse
  291.      }
  292.      { dup length dict
  293.      }
  294.         ifelse .copydict readonly
  295.       }
  296.      ifelse
  297.    } bind
  298.   /OutputAttributes 1 index
  299.   /Policies
  300.     { 3 copy pop .knownget
  301.        { dup length 2 index length add dict .copydict }
  302.        { dup length dict }
  303.       ifelse copy readonly
  304.     } bind
  305. .dicttomark readonly def
  306.  
  307. % Define the keys used in input attribute matching.
  308. /.inputattrkeys [
  309.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  310.     % The following are documented in Adobe's supplement for v2017.
  311.   /LeadingEdge /MediaClass
  312. ] readonly def
  313. % Define other keys used in media selection.
  314. /.inputselectionkeys [
  315.   /MediaPosition /Orientation
  316. ] readonly def
  317.  
  318. % Define the keys used in output attribute matching.
  319. /.outputattrkeys [
  320.   /OutputType
  321. ] readonly def
  322.  
  323. % Define all the parameters that should always be copied to the merged
  324. % dictionary.
  325. /.copiedkeys [
  326.   /OutputDevice
  327.   .mergespecial { pop } forall
  328.   .inputattrkeys aload pop
  329.   .inputselectionkeys aload pop
  330.   .outputattrkeys aload pop
  331. ] readonly def
  332.  
  333. % Define the parameters that should not be presented to the device.
  334. % The procedures are called as follows:
  335. %    <merged> <key> <value> -proc-
  336. % The procedure leaves all its operands on the stack and returns
  337. % true iff the key/value pair should be presented to .putdeviceparams.
  338. /.presentspecial mark
  339.   .dynamicppkeys { pop false } forall
  340.             % We must ignore an explicit request for .MediaSize,
  341.             % because media matching always handles this.
  342.   /.MediaSize false
  343.   /Name false
  344.   /OutputDevice false
  345.   /PageDeviceName false
  346.   /PageOffset false
  347.   /PageSize false        % obsolete alias for .MediaSize
  348.   /InputAttributes false
  349.   .inputattrkeys
  350.     { dup /PageSize eq
  351.        { pop }
  352.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  353.       ifelse
  354.     }
  355.   forall
  356.   .inputselectionkeys { false } forall
  357.   /OutputAttributes false
  358.   .outputattrkeys
  359.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  360.   forall
  361.   /Install false
  362.   /BeginPage false
  363.   /EndPage false
  364.   /Policies false
  365.     % Our extensions:
  366.   /HWColorMap
  367.     {            % HACK: don't transmit the color map, because
  368.             % window systems can change the color map on their own
  369.             % incrementally.  Someday we'll have a better
  370.             % solution for this....
  371.       false
  372.     }
  373.   /ViewerPreProcess false
  374. .dicttomark readonly def
  375.  
  376. % Define access to device defaults.
  377. /.defaultdeviceparams
  378.  { finddevice null .getdeviceparams
  379.  } bind def
  380.  
  381. % Select media (input or output).  The hard work is done in an operator:
  382. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  383. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  384. %    <pagedict> null <policydict> <keys> .matchmedia null true
  385. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  386.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  387.             %   .selectmedia
  388.  { 5 index 5 -2 roll 4 index .matchmedia
  389.         % Stack: orig request merged failed attrkeys mediakey
  390.         %   (key true | false)
  391.     { 4 index 3 1 roll put pop
  392.     }
  393.     {    % Adobe's implementations have a "big hairy heuristic"
  394.     % to choose the set of keys to report as having failed the match.
  395.     % For the moment, we report any keys that are in the request
  396.     % and don't have the same value as in the original dictionary.
  397.       5 index 1 index .knownget
  398.        { 4 index 3 1 roll put }
  399.        { 3 index exch .undef }
  400.       ifelse
  401.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  402.      3 index 1 index .knownget
  403.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  404.       { true }
  405.      ifelse        % Stack: ... <failed> <attrkey> <report>
  406.       { 2 copy /rangecheck put }
  407.      if pop
  408.        }
  409.       forall
  410.     }
  411.    ifelse
  412.  } bind def
  413.  
  414. % Apply Policies to any unprocessed failed requests.
  415. % As we process each request entry, we replace the error name
  416. % in the <failed> dictionary with the policy value,
  417. % and we replace the key in the <merged> dictionary with its prior value
  418. % (or remove it if it had no prior value).
  419. /.policyprocs mark
  420. % These procedures are called with the following on the stack:
  421. %   <orig> <merged> <failed> <Policies> <key> <policy>
  422. % They are expected to consume the top 2 operands.
  423. % NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
  424. % the same as 0, i.e., we signal an error.
  425.   0 {        % Set errorinfo and signal a configurationerror.
  426.     pop dup 4 index exch get 2 array astore
  427.     $error /errorinfo 3 -1 roll put
  428.     cleartomark
  429.     /setpagedevice load /configurationerror signalerror
  430.   } bind
  431.   1 {        % Roll back the failed request to its previous status.
  432. DEBUG { (Rolling back.) = pstack flush } if
  433.     3 index 2 index 3 -1 roll put
  434.     4 index 1 index .knownget
  435.      { 4 index 3 1 roll put }
  436.      { 3 index exch .undef }
  437.     ifelse
  438.   } bind
  439.   7 {        % For PageSize only, just impose the request.
  440.     1 index /PageSize eq
  441.      { pop pop 1 index /PageSize 7 put }
  442.      { .policyprocs 0 get exec }
  443.     ifelse
  444.   } bind
  445. .dicttomark readonly def
  446. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  447.             %   <orig> <merged'> <failed'>
  448.  { 1 index /Policies get 1 index
  449.     { type /integertype eq
  450.        { pop        % already processed
  451.        }
  452.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  453.             % Stack: <orig> <merged> <failed> <Policies> <key>
  454.             %   <policy>
  455.      .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
  456.        }
  457.       ifelse
  458.     }
  459.    forall pop
  460.  } bind def
  461.  
  462. % Prepare to present parameters to the device, by spreading them onto the
  463. % operand stack and removing any that shouldn't be presented.
  464. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  465.  { mark exch dup
  466.     {            % Stack: -mark- key1 value1 ... merged key value
  467.       .presentspecial 2 index .knownget
  468.        { exec { 3 -1 roll } { pop pop } ifelse }
  469.        { 3 -1 roll }
  470.       ifelse
  471.     }
  472.    forall pop
  473.  } bind def
  474.  
  475. % Put device parameters without resetting currentpagedevice.
  476. % (.putdeviceparams clears the current page device.)
  477. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  478.             %   <key1> <value1> ... .putdeviceparamsonly
  479.             % On success: <device> <eraseflag>
  480.             % On failure: <device> <Policies|null> <req_all> -mark-
  481.             %   <key1> <error1> ...
  482.  { .currentpagedevice
  483.     { counttomark 4 add 1 roll .putdeviceparams
  484.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  485.       .setpagedevice
  486.     }
  487.     { pop .putdeviceparams
  488.     }
  489.    ifelse
  490.  } bind def
  491.  
  492. % Try setting the device parameters from the merged request.
  493. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  494.             %   .trysetparams
  495.  { true 4 index .prepareparams
  496.             % Add the computed .MediaSize.
  497.             % Stack: merged (ignored) device Policies -true-
  498.             %   -mark- key1 value1 ...
  499.    counttomark 5 add index .computemediasize
  500.    exch pop exch pop /.MediaSize exch
  501. DEBUG { (Putting.) = pstack flush } if
  502.    .putdeviceparamsonly
  503. DEBUG { (Result of putting.) = pstack flush } if
  504.  } bind def
  505.  
  506. % Compute the media size and initial matrix from a merged request (after
  507. % media selection).
  508. /.computemediasize    % <request> .computemediasize
  509.             %   <request> <matrix> <[width height]>
  510.  { dup /PageSize get                    % requested page size
  511.    1 index /InputAttributes get
  512.      2 index (%MediaSource) get get /PageSize get    % media size
  513.                             % (may be a range)
  514.    2 index /Policies get
  515.      dup /PageSize .knownget
  516.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  517.                             % affects scaling
  518.    3 index /Orientation .knownget not { null } if
  519.    4 index /RollFedMedia .knownget not { false } if
  520.    matrix .matchpagesize not {
  521.         % This is a "can't happen" condition!
  522.      /setpagedevice load /rangecheck signalerror
  523.    } if
  524.    2 array astore
  525.  } bind def
  526.  
  527. % ---------------- setpagedevice itself ---------------- %
  528.  
  529. /setpagedevice
  530.  {        % We mustn't pop the argument until the very end,
  531.         % so that the pseudo-operator machinery can restore the stack
  532.         % if an error occurs.
  533.    mark 1 index currentpagedevice
  534.  
  535.         % Check whether we are changing OutputDevice;
  536.         % also handle the case where the current device
  537.         % is not a page device.
  538.         % Stack: mark <request> <current>
  539. DEBUG { (Checking.) = pstack flush } if
  540.  
  541.    dup /OutputDevice .knownget
  542.     {        % Current device is a page device.
  543.       2 index /OutputDevice .knownget
  544.        {    % A specific OutputDevice was requested.
  545.      2 copy eq
  546.       { pop pop null }
  547.       { exch pop }
  548.      ifelse
  549.        }
  550.        { pop null
  551.        }
  552.       ifelse
  553.     }
  554.     {        % Current device is not a page device.
  555.         % Use the default device.
  556.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  557.     }
  558.    ifelse
  559.    dup null eq
  560.     { pop
  561.     }
  562.     { exch pop .defaultdeviceparams
  563.         % In case of duplicate keys, .dicttomark takes the entry
  564.         % lower on the stack, so we can just append the defaults here.
  565.       .requiredattrs { exec } forall .dicttomark
  566.     }
  567.    ifelse
  568.  
  569.         % Check whether a viewer wants to intervene.
  570.         % We must check both the request (which takes precedence)
  571.         % and the current dictionary.
  572.         % Stack: mark <request> <orig>
  573.    exch dup /ViewerPreProcess .knownget
  574.     { exec }
  575.     { 1 index /ViewerPreProcess .knownget { exec } if }
  576.    ifelse exch
  577.  
  578.         % Construct a merged request from the actual request plus
  579.         % any keys that should always be propagated.
  580.         % Stack: mark <request> <orig>
  581. DEBUG { (Merging.) = pstack flush } if
  582.  
  583.    exch 1 index length 1 index length add dict
  584.    .copiedkeys
  585.     {        % Stack: <orig> <request> <merged> <key>
  586.       3 index 1 index .knownget { 3 copy put pop } if pop
  587.     }
  588.    forall
  589.         % Stack: <orig> <request> <merged>
  590.    dup 2 index
  591.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  592.       .mergespecial 2 index .knownget { exec } if
  593.       put dup
  594.     }
  595.    forall pop
  596.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  597.         % change HWResolution.
  598.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  599.         % Hack: if FIXEDMEDIA is true, discard any attempt to change
  600.         % PageSize or HWSize.
  601.    FIXEDMEDIA
  602.     { dup /PageSize 4 index /PageSize get put
  603.       dup /HWSize 4 index /HWSize get put
  604.     } if
  605.         % Hack: to work around some files that take a PageSize
  606.         % from InputAttributes and impose it, discard any attempt
  607.         % to set PageSize to a 4-element value.
  608.         % Stack: mark <orig> <request> <merged>
  609.     dup /PageSize .knownget {
  610.       length 2 ne {
  611.     dup /PageSize 4 index /PageSize get put
  612.       } if
  613.     } if
  614.  
  615.         % Select input and output media.
  616.         % Stack: mark <orig> <request> <merged>
  617. DEBUG { (Selecting.) = pstack flush } if
  618.  
  619.    0 dict    % <failed>
  620.    1 index /InputAttributes .knownget
  621.     { 2 index /Policies get
  622.       .inputattrkeys (%MediaSource) cvn .selectmedia
  623.     } if
  624.    1 index /OutputAttributes .knownget
  625.     { 2 index /Policies get
  626.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  627.      } if
  628.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  629.    .applypolicies
  630.    3 -1 roll 4 1 roll        % swap back
  631.  
  632.         % Construct the new device, and attempt to set its attributes.
  633.         % Stack: mark <orig> <request> <merged> <failed>
  634. DEBUG { (Constructing.) = pstack flush } if
  635.  
  636.    currentdevice .devicename 2 index /OutputDevice get eq
  637.     { currentdevice }
  638.     { 1 index /OutputDevice get finddevice }
  639.    ifelse
  640.         %**************** We should copy the device here,
  641.         %**************** but since we can't close the old device,
  642.         %**************** we don't.  This is WRONG.
  643.     %****************copydevice
  644.    2 index /Policies get
  645.    .trysetparams
  646.    dup type /booleantype ne
  647.     {        % The request failed.
  648.         % Stack: ... <orig> <request> <merged> <failed> <device>
  649.         %   <Policies> true mark <name> <errorname> ...
  650. DEBUG { (Recovering.) = pstack flush } if
  651.       counttomark 4 add index
  652.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  653.       pop pop pop
  654.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  655.         %   <Policies>
  656.       6 2 roll 3 -1 roll 4 1 roll
  657.       .applypolicies
  658.       3 -1 roll 4 1 roll 6 -2 roll
  659.       .trysetparams        % shouldn't fail!
  660.       dup type /booleantype ne
  661.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  662.          /setpagedevice load exch signalerror
  663.        }
  664.       if
  665.     }
  666.    if
  667.  
  668.         % The attempt succeeded.  Install the new device.
  669.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  670. DEBUG { (Installing.) = pstack flush } if
  671.  
  672.    pop 2 .endpage
  673.     { 1 true .outputpage
  674.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  675.     }
  676.    if
  677.         % .setdevice clears the current page device!
  678.    .currentpagedevice pop exch
  679.    .setdevice pop
  680.    .setpagedevice
  681.  
  682.         % Merge the request into the current page device,
  683.         % unless we're changing the OutputDevice.
  684.         % Stack: mark ... <merged> <failed>
  685.    exch currentpagedevice dup length 2 index length add dict
  686.         % Stack: mark ... <failed> <merged> <current> <newdict>
  687.    2 index /OutputDevice .knownget {
  688.      2 index /OutputDevice .knownget not { null } if eq
  689.    } {
  690.      true
  691.    } ifelse {
  692.         % Same OutputDevice, merge the dictionaries.
  693.      .copydict
  694.    } {
  695.         % Different OutputDevice, discard the old dictionary.
  696.      exch pop
  697.    } ifelse .copydict
  698.         % Initialize the default matrix, taking media matching
  699.         % into account.
  700.    .computemediasize pop initmatrix concat
  701.    dup /PageOffset .knownget
  702.     {        % Translate by the given number of 1/72" units in device X/Y.
  703.       dup 0 get exch 1 get
  704.       2 index /HWResolution get dup 1 get exch 0 get
  705.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  706.       idtransform translate
  707.     }
  708.    if
  709.         % We must install the new page device dictionary
  710.         % before calling the Install procedure.
  711.   dup .setpagedevice
  712.   .setdefaultscreen    % Set the default screen before calling Install.
  713.   dup /Install .knownget {
  714.     { .execinstall } stopped { .postinstall stop } { .postinstall } ifelse
  715.   } {
  716.     .postinstall
  717.   } ifelse
  718. } odef
  719.  
  720. % We break out the code after calling the Install procedure into a
  721. % separate procedure, since it is executed even if Install causes an error.
  722. % By making .execinstall a separate operator procedure, we get the stacks
  723. % restored if it fails.
  724.  
  725. /.execinstall {        % <proc> .execinstall -
  726.     % Because the interpreter optimizes tail calls, we can't just let
  727.     % the body of this procedure be 'exec', because that would lose
  728.     % the stack protection that is the whole reason for having the
  729.     % procedure in the first place.  We hack this by adding a couple
  730.     % of extra tokens to ensure that the operator procedure is still
  731.     % on the stack during the exec.
  732.   exec
  733.   0 pop    % See above.
  734. } odef
  735. /.postinstall {        % mark ... <failed> <merged> .postinstall -
  736.    matrix currentmatrix .setdefaultmatrix
  737.         % Erase and initialize the page.
  738.    erasepage initgraphics
  739.    .beginpage
  740.  
  741.         % Clean up, calling PolicyReport if needed.
  742.         % Stack: mark ... <failed> <merged>
  743. DEBUG { (Finishing.) = pstack flush } if
  744.  
  745.    exch dup length 0 ne
  746.     { 1 index /Policies get /PolicyReport get
  747.       counttomark 1 add 2 roll cleartomark
  748.       exec
  749.     }
  750.     { cleartomark
  751.     }
  752.    ifelse pop
  753.  
  754. } odef
  755.  
  756. end                % level2dict
  757. .setlanguagelevel
  758.